home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / win / pascal / pnt_bmp.exe / PAINTBMP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-05-03  |  3.3 KB  |  160 lines
  1. unit PaintBMP;
  2.  
  3. interface
  4.  
  5. uses Strings, WinTypes, WinProcs, WObjects;
  6.  
  7. {$R PAINTBMP.RES}
  8.  
  9. const
  10.   br_Check = 1;
  11.   br_Blank = 0;
  12.  
  13. type
  14.   PWinBMP = ^TWinBMP;
  15.   TWinBMP = object( TWindow)
  16.     TheBrush   : HBrush;
  17.     WinX, WinY,
  18.     WinH, WinW : integer;
  19.     DC         : HDC;
  20.  
  21.     constructor Init( AParent: PWindowsObject; ATitle: PChar; x1, y1, h1, w1: integer; St: longint);
  22.     destructor Done; virtual;
  23.     procedure MakeBrush( Brush: integer); virtual;
  24.     procedure PaintCheck; virtual;
  25.     procedure PaintBlank( x1, y1, x2, y2: integer); virtual;
  26.     procedure ShadowFrame( x1, y1, x2, y2: integer); virtual;
  27.     procedure ShadowHLine( x1, x2, y1: integer); virtual;
  28.     procedure ShadowVLine( x1, y1, y2: integer); virtual;
  29.   end;
  30.  
  31. implementation
  32.  
  33. constructor TWinBMP.Init( AParent: PWindowsObject; ATitle: PChar; x1, y1, h1, w1: integer; St: longint);
  34. begin
  35.   TWindow.Init( AParent, ATitle);
  36.  
  37.   WinX := 0;
  38.   WinY := 0;
  39.   WinH := h1;
  40.   WinW := w1;
  41.  
  42.   Attr.Style := St;
  43.   Attr.X := x1;
  44.   Attr.Y := y1;
  45.   Attr.H := h1 - 1;
  46.   Attr.W := w1 - 1;
  47.  
  48.   Create;
  49.   DC := GetDC( HWindow);
  50.   PaintCheck;
  51. end;
  52.  
  53. destructor TWinBMP.Done;
  54. begin
  55.   TWindow.Done;
  56.   ReleaseDC( HWindow, DC);
  57. end;
  58.  
  59. procedure TWinBMP.MakeBrush( Brush: integer);
  60. var
  61.   MyLogBrush: TLogBrush;
  62.   TheBitMap : HBitMap;
  63. begin
  64.   case Brush of
  65.     br_Check: TheBitMap := LoadBitMap( HInstance, 'CHECKS8X8');
  66.     br_Blank: TheBitMap := LoadBitMap( HInstance, 'BLANK8X8');
  67.   end;
  68.   MyLogBrush.lbStyle := bs_Pattern;
  69.   MyLogBrush.lbHatch := TheBitMap;
  70.   TheBrush := CreateBrushIndirect( MyLogBrush);
  71.   DeleteObject( TheBitMap);
  72. end;
  73.  
  74. procedure TWinBMP.ShadowFrame( x1, y1, x2, y2: integer);
  75. var
  76.   P1, P2: HPen;
  77. begin
  78.   P2 := CreatePen( ps_Solid, 1, $00808080);
  79.   P1 := GetStockObject( White_Pen);
  80.  
  81.   MoveTo( DC, x1, y2);
  82.   SelectObject( DC, P1);
  83.   LineTo( DC, x2, y2);
  84.   LineTo( DC, x2, y1);
  85.  
  86.   SelectObject( DC, P2);
  87.   LineTo( DC, x1, y1);
  88.   LineTo( DC, x1, y2);
  89.  
  90.   DeleteObject( P1);
  91.   DeleteObject( P2);
  92. end;
  93.  
  94. procedure TWinBMP.ShadowHLine( x1, x2, y1: integer);
  95. var
  96.   P1, P2: HPen;
  97. begin
  98.   P2 := CreatePen( ps_Solid, 1, $00808080);
  99.   P1 := GetStockObject( White_Pen);
  100.  
  101.   SelectObject( DC, P2);
  102.   MoveTo( DC, x1, y1);
  103.   LineTo( DC, x2, y1);
  104.  
  105.   SelectObject( DC, P1);
  106.   MoveTo( DC, x2, y1+1);
  107.   LineTo( DC, x1, y1+1);
  108.  
  109.   DeleteObject( P1);
  110.   DeleteObject( P2);
  111. end;
  112.  
  113. procedure TWinBMP.ShadowVLine( x1, y1, y2: integer);
  114. var
  115.   P1, P2: HPen;
  116. begin
  117.   P2 := CreatePen( ps_Solid, 1, $00808080);
  118.   P1 := GetStockObject( White_Pen);
  119.  
  120.   SelectObject( DC, P2);
  121.   MoveTo( DC, x1, y1);
  122.   LineTo( DC, x1, y2);
  123.  
  124.   SelectObject( DC, P1);
  125.   MoveTo( DC, x1+1, y2);
  126.   LineTo( DC, x1+1, y1);
  127.  
  128.   DeleteObject( P1);
  129.   DeleteObject( P2);
  130. end;
  131.  
  132. procedure TWinBMP.PaintCheck;
  133. var
  134.   MyRect: TRect;
  135. begin
  136.   MakeBrush( br_Check);
  137.   SelectObject( DC, TheBrush);
  138.   MyRect.left := WinX;
  139.   MyRect.top := WinY;
  140.   MyRect.right := WinW;
  141.   MyRect.bottom := WinH;
  142.   FillRect( DC, MyRect, TheBrush);
  143.   DeleteObject( TheBrush);
  144. end;
  145.  
  146. procedure TWinBMP.PaintBlank( x1, y1, x2, y2: integer);
  147. var
  148.   MyRect: TRect;
  149. begin
  150.   MakeBrush( br_Blank);
  151.   SelectObject( DC, TheBrush);
  152.   MyRect.left := x1;
  153.   MyRect.top := y1;
  154.   MyRect.right := x2;
  155.   MyRect.bottom := y2;
  156.   FillRect( DC, MyRect, TheBrush);
  157.   DeleteObject( TheBrush);
  158. end;
  159.  
  160. end.